home *** CD-ROM | disk | FTP | other *** search
/ CD Ware Multimedia 1995 May / cd Ware (Juegos) Epimundo.iso / DOS / PRGMMING / PBC30.ZIP / CALCDATE.BAS < prev    next >
Encoding:
BASIC Source File  |  1994-11-12  |  1.3 KB  |  40 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1994  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.  
  8.    DECLARE SUB CheckDate (BYVAL MonthNr%, BYVAL DayNr%, BYVAL YearNr%, ErrCode%)
  9.    DECLARE SUB DateA2R (BYVAL MonthNr%, BYVAL DayNr%, BYVAL YearNr%, RelDate&)
  10.    DECLARE SUB DateN2S (MonthNr%, DayNr%, YearNr%, DateSt$)
  11.    DECLARE SUB DateR2A (MonthNr%, DayNr%, YearNr%, RelDate&)
  12.  
  13. SUB CalcDate (StartDate$, Days&, Direction%, NewDate$, ErrCode%)
  14.    M% = VAL(StartDate$)
  15.    D% = VAL(MID$(StartDate$, 4))
  16.    Y% = VAL(MID$(StartDate$, 7))
  17.    IF Y% < 100 THEN Y% = Y% + 1900
  18.    CheckDate M%, D%, Y%, ErrCode%
  19.    IF ErrCode% THEN
  20.       ErrCode% = 2
  21.       EXIT SUB
  22.    END IF
  23.  
  24.    DateA2R M%, D%, Y%, SDate&
  25.    IF Direction% THEN
  26.       SDate& = SDate& - Days&
  27.    ELSE
  28.       SDate& = SDate& + Days&
  29.    END IF
  30.    IF SDate& < 0& THEN
  31.       ErrCode% = 3
  32.       EXIT SUB
  33.    END IF
  34.  
  35.    ErrCode% = 0
  36.    DateR2A M%, D%, Y%, SDate&
  37.    NewDate$ = StartDate$
  38.    DateN2S M%, D%, Y%, NewDate$
  39. END SUB
  40.